Winzipper/Winzipper_ISO.iso/programming/oracle7 7.2/DB/UTIL72/PRVTUTIL.SQL

Text File | 1995-05-09 | 31.2 KB | 851 lines

rem
rem $Header: prvtutil.sql 7020200.5 95/03/29 18:10:03 cli Generic<base> $
rem
Rem
Rem    NAME
Rem      prvtutil.sql - packages of various utility procedures
Rem    DESCRIPTION
Rem      These are private functions to be released in PL/SQL binary form.
Rem      This file contains various packages:
Rem         dbms_transaction    - transaction commands
Rem         dbms_session    - alter session commands
Rem         dbms_ddl        - ddl commands
Rem         dbms_utility    - helpful utilities
Rem         dbms_application_info - application information registration
Rem         dbms_space            - space analysis utilities
Rem    RETURNS
Rem
Rem    NOTES
Rem      The procedural option is needed to use these facilities.
Rem
Rem      All of the packages below run with the privileges of calling user,
Rem      rather than the package owner ('sys').
Rem
Rem      Procedure 'dbms_ddl.alter_compile' and 'dbms_ddl.analyze_object
Rem      commit the current transaction, perform the compilation, and
Rem      then commit again.
Rem
Rem      The dbms_utility package is run-as-caller (psdicd.c) only for
Rem      its name_resolve, compile_schema and analyze_schema
Rem      procedures.  This package is not run-as-caller
Rem      w.r.t. SQL (psdpgi.c) so that the SQL works correctly (runs as
Rem      SYS).  The privileges are checked via dbms_ddl.
Rem
Rem    MODIFIED   (MM/DD/YY)
Rem     bhirano    12/23/94 -  merge changes from branch 1.1.710.7
Rem     jstamos    11/11/94 -  merge changes from branch 1.1.710.6 (#239271)
Rem     rtaranto   10/28/94 -  merge changes from branch 1.1.710.5
Rem     rtaranto   10/28/94 -  Change context to be binary_integer
Rem     jloaiza    09/07/94 -  dbms_registration -> dbms_application_info
Rem     atsukerm   06/22/94 -  DBMS_SPACE implementation
Rem     wmaimone   05/26/94 -  #186155 add public synoyms for dba_
Rem     jloaiza    06/08/94 -  add dbms_registration
Rem     jloaiza    04/08/94 -  add dbms_system
Rem     dsdaniel   04/07/94 -  merge changes from branch 1.1.710.2
Rem     wmaimone   04/07/94 -  merge changes from branch 1.1.710.3
Rem     adowning   03/29/94 -  merge changes from branch 1.1.710.1
Rem     wmaimone   02/07/94 -  add set close_cached_open_cursors to dbms_sessio
Rem     dsdaniel   02/04/94 -  dbms_util.port_string icd
Rem     adowning   02/04/94 -  Branch_for_patch
Rem     adowning   02/04/94 -  Creation
Rem     adowning   02/02/94 -  split file into public / private binary files
Rem     rjenkins   10/28/93 -  make comma_to_table more consistent
Rem     rjenkins   10/12/93 -  adding comma_to_table
Rem     rjenkins   09/03/93 -  adding name_parse
Rem     hjakobss   07/15/93 -  bug 170473
Rem     hjakobss   07/13/93 -  bug 169577
Rem     dsdaniel   03/12/93 -  local_tid, step_id functions for replication
Rem     mmoore     01/11/93 -  merge changes from branch 1.37.312.1
Rem     mmoore     01/05/93 - #(145287) add another exception for discrete mode
Rem     mmoore     12/11/92 -  disable set_role in stored procs
Rem     rkooi      11/24/92 -  fixes per Peter
Rem     rkooi      11/21/92 -  get rid of error argument to name_resolve
Rem     tpystyne   11/20/92 -  fix compile_all and analyze_schema
Rem     rkooi      11/16/92 -  fix set_label
Rem     rkooi      11/16/92 -  fix comments
Rem     rkooi      11/13/92 -  add name_res procedure
Rem     tpystyne   11/07/92 -  make analyze parameters optional
Rem     mmoore     11/04/92 -  add new analyze options
Rem     ghallmar   11/03/92 -  add dbms_transaction.purge_mixed
Rem     rkooi      10/30/92 -  get rid of caller_id and unique_stmt_id
Rem     rkooi      10/26/92 -  owner -> schema for SQL2
Rem     rkooi      10/25/92 -  bug 135880
Rem     mmoore     10/13/92 - #(131686) change messages 2074,4092,0034
Rem     rkooi      10/02/92 -  compile_all fix
Rem     mmoore     10/02/92 -  change pls_integer to binary_integer
Rem     tpystyne   10/01/92 -  fix Bob's mistakes
Rem     tpystyne   09/28/92 -  disallow commit/rollback force in rpc and trigge
Rem     mmoore     09/25/92 - #(130566) don't allow set_nls or set_role in trig
Rem     tpystyne   09/23/92 -  rename analyze to analyze_object
Rem     rkooi      08/24/92 -  handle delimited id's in alter_compile
Rem     tpystyne   08/06/92 -  add analyze_schema
Rem     epeeler    07/29/92 -  add function to get time
Rem     rkooi      06/25/92 -  workaround pl/sql bug with 'in' in SQL
Rem     rkooi      06/03/92 -  add 'get unique session id'
Rem     jcohen     05/28/92 -  add = to alter session set label
Rem     jloaiza    05/12/92 -  add discrete
Rem     rkooi      04/22/92 -  put in checks for execute_sql for triggs, stored
Rem     mmoore     04/14/92 -  move begin_oltp to package transaction
Rem     rkooi      04/06/92 -  merge changes from branch 1.4.300.1
Rem     rkooi      04/01/92 -  Creation - split/recombined from other files
Rem     mroberts   02/21/92 -  call alter_compile, not sql_ddl
Rem     rkooi      02/06/92 -  testing
Rem     rkooi      02/03/92 -  compilation errors
Rem     rkooi      01/16/92 -  Creation

REM ********************************************************************
REM THESE PACKAGES MUST NOT BE MODIFIED BY THE CUSTOMER.  DOING SO
REM COULD CAUSE INTERNAL ERRORS AND SECURITY VIOLATIONS IN THE
REM RDBMS.  SPECIFICALLY, THE PSD* AND EXECUTE_SQL ROUTINES MUST NOT BE
REM CALLED DIRECTLY BY ANY CLIENT AND MUST REMAIN PRIVATE TO THE PACKAGE BODY.
REM ********************************************************************

create or replace package body dbms_transaction is
  -- internal icd:  perform DDL statement
  procedure execute_sql(coord_sess_ok binary_integer, forms_ok binary_integer,
      trigger_ok binary_integer, procedure_ok binary_integer, stmt varchar2,
      error_hint varchar2);
    pragma interface (C, execute_sql);                     -- 6 (see psdicd.c)

  -- internal icd: get transaction id
  function ltid_icd(create_txn binary_integer) return varchar2;
    pragma interface (c, ltid_icd);                        -- 7 (see psdicd.c)

  -- internal icd: get step id
  function step_icd return number;
    pragma interface (c, step_icd);                        -- 8 (see psdicd.c)

  procedure commit_force(xid varchar2, scn varchar2 default null) is
  begin
    if scn is NULL then
      execute_sql(0, 0, 0, 1, 'commit force ''' || xid || '''', 'COMMIT');
    else
      execute_sql(0, 0, 0, 1, 'commit force ''' || xid || ''' ''' ||
        scn || '''', 'COMMIT');
    end if;
  end;

  procedure rollback_force(xid varchar2) is
  begin
    execute_sql(0, 0, 0, 1, 'rollback force ''' || xid || '''', 'ROLLBACK');
  end;

  procedure advise_commit is
  begin
    execute_sql(1, 1, 1, 1, 'alter session advise commit', 'ADVISE COMMIT');
  end;

  procedure advise_rollback is
  begin
    execute_sql(1, 1, 1, 1, 'alter session advise rollback',
                 'ADVISE ROLLBACK');
  end;

  procedure advise_nothing is
  begin
    execute_sql(1, 1, 1, 1, 'alter session advise nothing','ADVISE NOTHING');
  end;

  procedure commit_comment(cmnt varchar2) is
  begin
    execute_sql(0, 0, 0, 1, 'commit comment ' || '''' || cmnt || '''',
                'COMMIT');
  end;

  procedure read_only is
  begin
    execute_sql(0, 1, 0, 1, 'set transaction read only', 'SET TRANSACTION');
  end;

  procedure read_write is
  begin
    execute_sql(0, 1, 0, 1, 'set transaction read write', 'SET TRANSACTION');
  end;

  procedure use_rollback_segment(rb_name varchar2) is
  begin
    execute_sql(0, 1, 0, 1, 'set transaction use rollback segment ' || rb_name,
       'SET TRANSACTION');
  end;

  procedure purge_mixed(xid varchar2) is
    transaction_not_found exception;
  begin
    use_rollback_segment('SYSTEM');
    delete from sys.pending_trans$ where status = 'D' and local_tran_id = xid;
    if sql%rowcount = 1 then
      delete from sys.pending_sessions$ where local_tran_id = xid;
      delete from sys.pending_sub_sessions$ where local_tran_id = xid;
    else
      raise transaction_not_found;
    end if;
  end;

  FUNCTION local_transaction_id(create_transaction BOOLEAN := FALSE)
    RETURN VARCHAR2 is
  begin
    if create_transaction then
      return(ltid_icd(1));
    else
      return(ltid_icd(0));
    end if;
  end;

  FUNCTION step_id RETURN NUMBER is
  begin
   return(step_icd);
  end;

end;
/

create or replace package body dbms_session is
  -- internal icd:  perform DDL statement
  procedure execute_sql(coord_sess_ok binary_integer, forms_ok binary_integer,
      trigger_ok binary_integer, procedure_ok binary_integer, stmt varchar2,
      error_hint varchar2);
    pragma interface (C, execute_sql);                      -- 1 (see psdicd.c)

  -- deinstantiate all pkgs in this session
  procedure psddin;                        -- 2 (see psdicd.c)
    pragma interface (C, psddin);

  -- get an id that is unique for all sessions in this database
  function psduis return varchar2;                -- 3 (see psdicd.c)
    pragma interface (C, psduis);

  -- is given role enabled?
  function psdire(rolename varchar2) return binary_integer; -- 4 (see psdicd.c)
    pragma interface (C, psdire);

  -- free unused memory from user heap
  procedure psdfmr(heapno binary_integer, recurse binary_integer);
    pragma interface (C, psdfmr);                           -- 5 (see psdicd.c)

  procedure set_role(role_cmd varchar2) is
  begin
    execute_sql(1, 1, 0, 0, 'set role ' || role_cmd, 'SET ROLE');
  end;

  procedure set_sql_trace(sql_trace boolean) is
  begin
    if sql_trace then
      execute_sql(1, 1, 1, 1, 'alter session set sql_trace true',
        'SET SQL_TRACE');
    else
      execute_sql(1, 1, 1, 1, 'alter session set sql_trace false',
        'SET SQL_TRACE');
    end if;
  end;

  procedure set_nls(param varchar2, value varchar2) is
    ddl_error exception;
  begin
    /* prevent sneaking in other 'alter session set' commands */
    if substr(upper(param),1,4) <> 'NLS_'
        or length(value) > 20 then
      raise ddl_error;
    end if;
    execute_sql(0, 1, 0, 1, 'alter session set ' || param || ' = ' || value,
       'SET NLS');
  end;

  procedure close_database_link(dblink varchar2) is
  begin
    execute_sql(1, 1, 1, 1, 'alter session close database link ' || dblink,
      'CLOSE DATABASE LINK');
  end;

  procedure set_label(lbl varchar2) is
  begin
    if upper(lbl) = 'DBHIGH' or upper(lbl) = 'DBLOW' then
      execute_sql(0, 1, 1, 1, 'alter session set label = ' || lbl, 'SET LABEL');
    else
      execute_sql(0, 1, 1, 1, 'alter session set label = ''' || lbl || '''',
        'SET LABEL');
    end if;
  end;

  procedure set_mls_label_format(fmt varchar2) is
  begin
    execute_sql(0, 1, 1, 1,
      'alter session set mls_label_format = ''' || fmt || '''',
      'SET MLS LABEL FORMAT');
  end;

  procedure reset_package is
  begin
    psddin;
  end;

  function unique_session_id return varchar2 is
  begin
    return psduis;
  end;

  function is_role_enabled(rolename varchar2) return boolean is
  begin
    if psdire(rolename) = 1 then
      return TRUE;
    else
      return FALSE;
    end if;
  end;

  procedure set_close_cached_open_cursors(close_cursors boolean) is
  begin
    if close_cursors then
      execute_sql(1, 1, 1, 1,
    'alter session set close_cached_open_cursors = true',
        'SET CLOSE_CACHED_OPEN_CURSORS');
   else
      execute_sql(1, 1, 1, 1,
    'alter session set close_cached_open_cursors = false',
        'SET CLOSE_CACHED_OPEN_CURSORS');
    end if;
  end;

  procedure free_unused_user_memory(heapno binary_integer, recurse boolean) is
    recval binary_integer;
  begin
    if recurse then                      -- set recurse to a binary_integer
      recval := 1;
    else
      recval := 0;
    end if;

    psdfmr(heapno,recval);               -- invoke the icd
  end;

  procedure free_unused_user_memory is
  begin
    free_unused_user_memory(0, TRUE);       -- call 'internal' function
  end;

end;
/

create or replace package body dbms_ddl is
  NOT_EXIST0 exception;
  pragma EXCEPTION_INIT(NOT_EXIST0, -942);
  NOT_EXIST1 exception;
  pragma EXCEPTION_INIT(NOT_EXIST1, -4042);
  NOT_EXIST2 exception;
  pragma EXCEPTION_INIT(NOT_EXIST2, -4043);
  NOT_EXIST3 exception;
  pragma EXCEPTION_INIT(NOT_EXIST3, -6564);
  NOT_EXIST4 exception;
  pragma EXCEPTION_INIT(NOT_EXIST4, -943);
  NOT_EXIST5 exception;
  pragma EXCEPTION_INIT(NOT_EXIST5, -1418);
  NO_PRIV    exception;
  pragma EXCEPTION_INIT(NO_PRIV, -1031);

  -- internal icd:  perform DDL statement
  procedure execute_sql(coord_sess_ok binary_integer, forms_ok binary_integer,
      trigger_ok binary_integer, procedure_ok binary_integer, stmt varchar2,
      error_hint varchar2);
    pragma interface (C, execute_sql);                      -- 1 (see psdicd.c)

  procedure alter_compile(type varchar2, schema varchar2, name varchar2) is
    ptype      varchar2(20);
    pschema    varchar2(30);
    pname      varchar2(65);
    owner      varchar2(30);
    part1      varchar2(30);
    part2      varchar2(30);
    dblink     varchar2(30);
    part1_type number;
    objno      number;
  begin
    pschema := schema;
    pname := name;
    if pschema IS NOT NULL then
      pname := pschema || '"."' || pname;
    end if;
    pname := '"' || pname || '"';

    begin
      /* name resolve to make sure the object is not a synonym for something
         that we depend on, an hence would cause a deadlock */
      dbms_utility.name_resolve(pname, 1, owner, part1, part2, dblink,
                                part1_type, objno);
    exception when not_exist3 or no_priv then
      raise_application_error(-20000, 'Unable to compile ' || type || ' '
        || pname || ', insufficient privileges or does not exist');
    end;

    if (objno is null or dblink is not null) then
      raise_application_error(-20001, 'cannot compile remote ' || type ||
        ' ' || pname);
    end if;
    if owner = 'SYS'
         and part1 in ('DBMS_STANDARD', 'STANDARD', 'DBMS_DDL') then
      return;
    end if;

    ptype := upper(type);
    commit; -- this commit will fail if in coordinated sesson or
            -- if forms has done 'alter session disable commits ...'
        -- so the 1st two args to execute_sql below are irrelevant
    begin
      if ptype = 'PACKAGE BODY' then
        execute_sql(0, 0, 0, 1, 'alter package ' || pname || ' compile body',
          'ALTER PACKAGE COMPILE');
      elsif ptype = 'PACKAGE' then
        execute_sql(0, 0, 0, 1, 'alter package ' || pname || ' compile',
          'ALTER PACKAGE COMPILE');
      elsif ptype = 'PROCEDURE' or ptype = 'FUNCTION' then
        execute_sql(0, 0, 0, 1, 'alter ' || ptype || ' ' || pname || ' compile',
          'ALTER PROCEDURE COMPILE');
      else
        raise_application_error(-20001, 'bad value for object type: '||ptype);
      end if;
    exception when not_exist1 or not_exist2 or no_priv then
      raise_application_error(-20000, 'Unable to compile ' || type || ' '
        || pname || ', insufficient privileges or does not exist');
    end;
    commit;
  end;

  procedure analyze_object
    (type varchar2, schema varchar2, name varchar2, method varchar2,
     estimate_rows number default null,
     estimate_percent number default null) is
    oname  varchar2(65);
    sample varchar2(30) := '';
  begin
    oname := name;
    if schema IS NOT NULL then
      oname := schema || '"."' || name;
    end if;
    oname := '"' || oname || '"';

    commit;

    -- don't analyze fet$ and uet$, could possibly cause deadlocks
    if schema = 'SYS' and name in ('UET$', 'FET$') then return; end if;

    if upper(method) = 'ESTIMATE' then
      if estimate_rows != 0 then
        sample := 'sample '||estimate_rows||' rows';
      elsif estimate_percent != 0 then
        sample := 'sample '||estimate_percent||' percent';
      end if;
    end if;

    begin
      if upper(type) = 'CLUSTER' then
        execute_sql(0, 0, 0, 1,
          'analyze cluster '||oname||' '||method||' statistics '||sample,
          'ANALYZE CLUSTER');
      elsif upper(type) = 'TABLE' then
        execute_sql(0, 0, 0, 1,
          'analyze table '||oname||' '||method||' statistics '||sample,
          'ANALYZE TABLE');
      elsif upper(type) = 'INDEX' then
        execute_sql(0, 0, 0, 1,
          'analyze index '||oname||' '||method||' statistics '||sample,
          'ANALYZE INDEX');
      else
        raise_application_error(-20001, 'bad value for object type: ' || type);
      end if;
    exception when not_exist0 or not_exist1 or not_exist2 or not_exist4 or
         not_exist5 or no_priv then
      raise_application_error(-20000, 'Unable to analyze ' || type || ' '
        || oname || ', insufficient privileges or does not exist');
    end;
    commit;
  end;

end;
/

create or replace view order_object_by_dependency (dlevel, object_id) as
       select max(level), object_id from public_dependency
       connect by object_id = prior referenced_object_id
       group by object_id
/

create or replace view dba_analyze_objects (owner, object_name, object_type) as
       select u.name, o.name, decode(o.type, 2, 'TABLE', 3, 'CLUSTER')
       from sys.user$ u, sys.obj$ o, sys.tab$ t
       where o.owner# = u.user#
       and   o.obj# = t.obj# (+)
       and   t.clu# is null
       and   o.type in (2,3)
/

create or replace package body dbms_utility is
  function is_parallel return binary_integer;
    pragma interface (C, is_parallel);                  -- 3 (see psdicd.c)
  function icd_get_time return binary_integer;
    pragma interface (C, icd_get_time);                -- 4 (see psdicd.c)
  procedure icd_name_res(name in varchar2, context in binary_integer,
      schema out varchar2, part1 out varchar2, part2 out varchar2,
      dblink out varchar2, part1_type out binary_integer,
      object_number out binary_integer);
    pragma interface (C, icd_name_res);                -- 5 (see psdicd.c)
  procedure icd_name_tokenize( name    in  varchar2,
                       a       out varchar2,
                       b       out varchar2,
                           c       out varchar2,
                               dblink  out varchar2,
                               nextpos out binary_integer);
    pragma interface (C, icd_name_tokenize);                -- 6 (see psdicd.c)
  FUNCTION psdpor RETURN VARCHAR2;
    pragma interface (C, psdpor);                           -- 7 (see psdicd.c)

  function icd_dba(file binary_integer, block binary_integer)
       return binary_integer;
    pragma interface (C, icd_dba);                        -- 8 (see psdicd.c)

  function icd_dba_file(dba binary_integer) return binary_integer;
    pragma interface (C, icd_dba_file);                        -- 9 (see psdicd.c)

  function icd_dba_block(dba binary_integer) return binary_integer;
    pragma interface (C, icd_dba_block);                    -- 10(see psdicd.c)

  procedure name_resolve(name in varchar2, context in number,
    schema out varchar2, part1 out varchar2, part2 out varchar2,
    dblink out varchar2, part1_type out number, object_number out number) is
  begin
    if context != 1 and context != 3 then
  raise_application_error(-20005, 'ORU-10034: context argument must be 1 or 3');
    end if;
    icd_name_res(name, context, schema, part1, part2, dblink, part1_type,
      object_number);
  end;

  procedure name_tokenize( name    in  varchar2,
                   a       out varchar2,
                          b       out varchar2,
                       c       out varchar2,
                   dblink  out varchar2,
                   nextpos out binary_integer) is
  begin
    icd_name_tokenize( name, a, b, c, dblink, nextpos );
  end;

  -- Make a PL/SQL table out of a comma-separated list of names
  --   names :== a [. b [. c ]][ @ d ]
  --   list :== name [ , list ]
  --   Comma_to_table takes a non-empty comma-separated list.
  --   Anything other than a comma-separated list is rejected.
  --   Commas inside doublequotes do not count.
  --   A PL/SQL table is returned, with values 1..n, and n+1 is null.
  --   The values in tab are cut from the original list; no transformations.
  PROCEDURE comma_to_table( list   IN  VARCHAR2,
                            tablen OUT BINARY_INTEGER,
                            tab    OUT uncl_array ) IS
    nextpos    BINARY_INTEGER;
    oldpos     BINARY_INTEGER;
    done       BOOLEAN;
    i          BINARY_INTEGER;
    len        BINARY_INTEGER;
    dummy      VARCHAR2(128);
  BEGIN
    -- get ready
    nextpos  := 1;
    done     := FALSE;
    i        := 1;
    len      := NVL(LENGTHB(list),0);

    WHILE NOT done LOOP
      oldpos := nextpos;
      dbms_utility.name_tokenize( SUBSTRB(list,oldpos),
                           dummy, dummy, dummy, dummy, nextpos );
      tab(i) := SUBSTRB( list, oldpos, nextpos );
      nextpos := oldpos + nextpos;
      IF nextpos > len THEN
        done := TRUE;
      ELSIF SUBSTRB(list,nextpos,1) = ',' then
        nextpos := nextpos + 1;
      ELSE
        raise_application_error( -20001,
          'comma-separated list invalid near ' || SUBSTRB(list,nextpos-2,5));
      END IF;
      i := i + 1;
    END LOOP;

    -- handle the end of the list
    tab(i) := NULL;
    tablen := i-1;
  END;


  -- Make a comma-separated list out of a PL/SQL table
  --   table_to_comma takes a PL/SQL table, 1..n, terminated with n+1 null.
  --   table_to_comma returns a comma-separated list and
  --     the number of elements found in the table (n).
  --   Note that ',,,' || ',' || ',,,' = ',,,,,,,'.
  PROCEDURE table_to_comma( tab    IN  uncl_array,
                            tablen OUT BINARY_INTEGER,
                            list   OUT VARCHAR2) IS
    temp  VARCHAR2(6500) := '';
    i     BINARY_INTEGER :=  1;
  BEGIN
    IF tab(i) IS NOT NULL THEN
      temp := tab(i);
      i    := i + 1;
      WHILE tab(i) IS NOT NULL LOOP
        temp := temp || ',' || tab(i);
        i := i + 1;
      END LOOP;
    END IF;
    tablen := i-1;
    list   := temp;
  EXCEPTION
    WHEN NO_DATA_FOUND THEN
      tablen := i-1;
      list   := temp;
  END;

  function get_time return number is
  begin
    return icd_get_time;
  end;

  function is_parallel_server return boolean is
  begin
    if is_parallel = 1 then
      return TRUE;
    else
      return FALSE;
    end if;
  end;

  procedure compile_schema (schema varchar2) is
    NOT_EXIST_OR_NO_PRIV exception;
    pragma EXCEPTION_INIT(NOT_EXIST_OR_NO_PRIV, -20000);

    cursor c1(schema varchar2) is
      select a.object_type, a.object_name, a.status
      from sys.order_object_by_dependency p, sys.dba_objects a
      where p.object_id = a.object_id
        and a.owner = c1.schema
               /* need PACKAGE BODY in clause below so that dependency ordering
         is done correctly.  But since compiling a package spec also
         compiles the body (we don't have an 'alter package foo compile
     spec only' command), skip over package bodies in the loop below.
         Then if there are any invalid bodies take care of them in a
         final pass */
      and (a.object_type = 'FUNCTION' or a.object_type = 'PROCEDURE' or
           a.object_type = 'PACKAGE' or a.object_type = 'PACKAGE BODY')
      order by dlevel desc;
  begin
    for rec in c1(schema) loop
      if rec.object_type <> 'PACKAGE BODY' and (schema <> 'SYS' or
          rec.object_name not in ('DBMS_UTILITY', 'DBMS_SESSION',
          'DBMS_TRANSACTION')) then
        begin
          dbms_ddl.alter_compile(rec.object_type, schema, rec.object_name);
        exception when NOT_EXIST_OR_NO_PRIV then
          raise_application_error(-20000,
            'You have insufficient privileges for an object in this schema.');
        end;
      end if;
    end loop;

    -- now look for any bodies which were invalidated after their
    -- compilation due to compilation of other specs.  If we had an
    -- 'alter package foo compile spec only' command then we wouldn't need
    -- this loop as we could take care of bodies in the loop above without
    -- causing duplicate compiles for all bodies.
    for rec in c1(schema) loop
      if rec.object_type = 'PACKAGE BODY' and rec.status = 'INVALID' and
          (schema <> 'SYS' or rec.object_name not in ('DBMS_UTILITY',
           'DBMS_SESSION', 'DBMS_TRANSACTION')) then
        begin
          dbms_ddl.alter_compile(rec.object_type, schema, rec.object_name);
        exception when NOT_EXIST_OR_NO_PRIV then
          raise_application_error(-20000,
            'You have insufficient privileges for an object in this schema.');
        end;
      end if;
    end loop;

    dbms_session.reset_package;
  end;

  procedure analyze_schema(schema varchar2, method varchar2,
                           estimate_rows number default null,
                           estimate_percent number default null) is
    NOT_EXIST_OR_NO_PRIV exception;
    pragma EXCEPTION_INIT(NOT_EXIST_OR_NO_PRIV, -20000);

    cursor c1(schema varchar2) is
      select object_name, object_type
      from sys.dba_analyze_objects
      where owner = c1.schema
      order by object_type, object_name;
  begin
    -- analyze all clusters and non-clustered tables in the schema
    for rec in c1(schema) loop
        begin
          dbms_ddl.analyze_object(rec.object_type, schema, rec.object_name,
                                  method, estimate_rows, estimate_percent);
        exception when NOT_EXIST_OR_NO_PRIV then
          raise_application_error(-20000,
            'You have insufficient privileges for an object in this schema.');
        end;
    end loop;
  end;

  FUNCTION port_string RETURN VARCHAR2 IS
  BEGIN
    RETURN(psdpor);
  END port_string;

  function make_data_block_address(file number, block number) return number is
  begin
    return (icd_dba(file,block));
  end;

  function data_block_address_file(dba number) return number is
  begin
    return (icd_dba_file(dba));
  end;

  function data_block_address_block(dba number) return number is
  begin
    return (icd_dba_block(dba));
  end;

END dbms_utility;
/


create or replace package body dbms_system is

  procedure set_ev_icd(sid binary_integer, ser binary_integer,
               ev binary_integer, lev binary_integer, name varchar2);
    pragma interface (C, set_ev_icd);                      -- 1 (see psdicd.c)
  --  This is an internally used routine that should never be called by users.

  procedure read_ev_icd(iev binary_integer, oev out binary_integer);
    pragma interface (C, read_ev_icd);                     -- 2 (see psdicd.c)
  --  This is an internally used routine that should never be called by users.

  procedure set_sql_trace_in_session(sid number, serial# number,
                                 sql_trace boolean) is
  begin
    if sql_trace
    then set_ev(sid, serial#, 10046, 1, '');
    else set_ev(sid, serial#, 10046, 0, '');
    end if;
  end;

  -- set event in sesssion
  procedure set_ev(si binary_integer, se binary_integer,
               ev binary_integer, le binary_integer, nm varchar2) is
    begin set_ev_icd(si,se,ev,le,nm); end;

  -- read value of event
  procedure read_ev(iev binary_integer, oev out binary_integer) is
    begin read_ev_icd(iev, oev); end;

end dbms_system;
/



create or replace package body dbms_application_info is
  procedure icd_set_module(module_name varchar2, action_name varchar2);
    pragma interface (C, icd_set_module);               -- 1 (see psdicd.c)

  procedure icd_set_action(action_name varchar2);
    pragma interface (C, icd_set_action);               -- 2 (see psdicd.c)

  procedure icd_read_module(module_name out varchar2);
    pragma interface (C, icd_read_module);              -- 3 (see psdicd.c)

  procedure icd_read_action(action_name out varchar2);
    pragma interface (C, icd_read_action);              -- 4 (see psdicd.c)

  procedure icd_set_client_info(client_info varchar2);
    pragma interface (C, icd_set_client_info);             -- 5 (see psdicd.c)

  procedure icd_read_info(client_info out varchar2);
    pragma interface (C, icd_read_info);                -- 6 (see psdicd.c)


  procedure set_module(module_name varchar2, action_name varchar2) is
    begin icd_set_module(module_name, action_name); end;

  procedure set_action(action_name varchar2) is
    begin icd_set_action(action_name); end;

  -- for some reason reading the module and the action in one ICD did not
  -- work (I kept getting access violations).  Splitting them up into two
  -- made it work.
  procedure read_module(module_name out varchar2, action_name out varchar2) is
  begin
    icd_read_module(module_name);
    icd_read_action(action_name);
  end;

  procedure set_client_info(client_info varchar2) is
    begin icd_set_client_info(client_info); end;

  procedure read_client_info(client_info out varchar2) is
    begin icd_read_info(client_info); end;

end;
/

create or replace package body dbms_space is

  procedure ktsbusp     (segment_owner IN varchar2,
                         segment_name IN varchar2,
                         segment_type IN varchar2,
                         total_blocks OUT number,
                         total_bytes OUT number,
                         unused_blocks OUT number,
                         unused_bytes OUT number,
                         last_used_extent_file_id OUT number,
                         last_used_extent_block_id OUT number,
                         last_used_block OUT number
                         );
  pragma interface(C, ktsbusp);                  -- 1 (see ktsb.c)

  procedure ktsbfbl     (segment_owner IN varchar2,
                         segment_name IN varchar2,
                         segment_type IN varchar2,
                         freelist_group_id IN number,
                         free_blks OUT number,
                         scan_limit IN number DEFAULT NULL
                         );
  pragma interface(C, ktsbfbl);                  -- 2 (see ktsb.c)

  procedure unused_space(segment_owner IN varchar2,
                         segment_name IN varchar2,
                         segment_type IN varchar2,
                         total_blocks OUT number,
                         total_bytes OUT number,
                         unused_blocks OUT number,
                         unused_bytes OUT number,
                         last_used_extent_file_id OUT number,
                         last_used_extent_block_id OUT number,
                         last_used_block OUT number
                         ) IS
  BEGIN
    ktsbusp(segment_owner, segment_name, segment_type, total_blocks,
        total_bytes, unused_blocks, unused_bytes, last_used_extent_file_id,
        last_used_extent_block_id, last_used_block);
  END unused_space;

  procedure free_blocks (segment_owner IN varchar2,
                         segment_name IN varchar2,
                         segment_type IN varchar2,
                         freelist_group_id IN number,
                         free_blks OUT number,
                         scan_limit IN number DEFAULT NULL
                         ) IS
  BEGIN
    ktsbfbl(segment_owner, segment_name, segment_type, freelist_group_id,
        free_blks, scan_limit);
  END free_blocks;
end;
/